﻿<script language="javascript" runat="server">
  function urlEncode(str){
    if (str == null) return null;
    return escape(str);
  }
  function urlDecode(str){
     if (str == null) return null;
     return unescape(str);
  }
  
  //将对象数据转成数组，支持vb class实例
  function objToJSArray(o){
     var a = new Array();
     for (var k in o) 
       a.push(o[k]); 
     return a; 
  }
  
  //将数组数据赋值给对象属性，支持vb class实例
  function objFromVBArray(o, vbarr){
     if (vbarr==null ) return;
     var a = new VBArray(vbarr).toArray()
     var i = 0; 
     for (var k in o) {
        if (a.length < i) break;
        o[k]=a[i];
       i++; 
     }
     return a; 
  }
  
  function trim(str) {   
      if(str.charAt(0) == " ") {   
          str = str.substring(1,str.length);   
          str = trim(str);   
      }   
      if(str.charAt(str.length - 1) == " ") {   
          str = str.substring(0, str.length - 1);   
          str = trim(str);   
      }   
      return str;   
  }  
  
  
  function formatDate(v){    
    if(typeof v == 'string'){
        v = new Date(Date.parse(trim(v).replace(/-/g,"/")));     
    }
    if(!(v instanceof Date)|| isNaN(v.getTime())){
        v = new Date();
    }        
    var y = v.getFullYear();        
    var m = v.getMonth() + 1;        
    var d = v.getDate();        
    var h = v.getHours();        
    var i = v.getMinutes();        
    var s = v.getSeconds();        
    //var ms = v.getMilliseconds();           
    //if(ms>0) return y + '-' + m + '-' + d + ' ' + h + ':' + i + ':' + s + '.' + ms;        
    if(h>0 || i>0 || s>0) return y + '-' + m + '-' + d + ' ' + h + ':' + i + ':' + s;        
    return y + '-' + m + '-' + d;        
      
  }     

    function toUnicode(str) {
        var a = [], i = 0;
       
        for (; i < str.length ;) a[i] = str.charCodeAt(i ++);
       
        return "&#" + a.join(";&#") + ";";
   }
        
</script>


<script language="vbscript" runat="server">
  '将javascript数组转换成vbscript数组
  function JSArrayToVBArray(jsarr)
    if TypeName(jsarr)<>"JScriptTypeInfo" then 
      JSArrayToVBArray = jsarr
      exit function
    end if
    dim i,vbarr
    redim vbarr(jsarr.length)
    for i=0 to jsarr.length-1 
      'Set v = CallByName(jsarr, i, VbGet)
      vbarr(i) = eval("jsarr.[" &  i & "]") 
    next
    JSArrayToVBArray = vbarr
  end function   
  
  '将对象数据转成数组
  function objToArray(o)
    objToArray = JSArrayToVBArray(objToJSArray(o))
  end function
  
  '将数组数据赋值给对象属性
  function objFromArray(o, a)
    call objFromVBArray(o, a)
  end function

  Function StringToDate(gtmStr)
      StringToDate = CDate(formatDate(gtmStr))
  End Function 
  
  ' Converts date (19991022 11:08:38) to http form (Fri, 22 Oct 1999 12:08:38 GMT)
  Function DateToGMT(ByVal OleDATE)
    Const GMTdiff = #08:00:00#
    OleDATE = OleDATE - GMTdiff
    DateToGMT = engWeekDayName(OleDATE) & _
      ", " & Right("0" & Day(OleDATE),2) & " " & engMonthName(OleDATE) & _
      " " & Year(OleDATE) & " " & Right("0" & Hour(OleDATE),2) & _
      ":" & Right("0" & Minute(OleDATE),2) & ":" & Right("0" & Second(OleDATE),2) & " GMT"
  End Function 
  
  Function engWeekDayName(dt)
      Dim Out
      Select Case WeekDay(dt,1)
          Case 1:Out="Sun"
          Case 2:Out="Mon"
          Case 3:Out="Tue"
          Case 4:Out="Wed"
          Case 5:Out="Thu"
          Case 6:Out="Fri"
          Case 7:Out="Sat"
      End Select
      engWeekDayName = Out
  End Function
  
  Function engMonthName(dt)
      Dim Out
      Select Case Month(dt)
          Case 1:Out="Jan"
          Case 2:Out="Feb"
          Case 3:Out="Mar"
          Case 4:Out="Apr"
          Case 5:Out="May"
          Case 6:Out="Jun"
          Case 7:Out="Jul"
          Case 8:Out="Aug"
          Case 9:Out="Sep"
          Case 10:Out="Oct"
          Case 11:Out="Nov"
          Case 12:Out="Dec"
      End Select
      engMonthName = Out
  End Function
  
  
  
  
  Function strLen(str)
      dim p_len
      p_len=0
      strlen=0
      if trim(str)<>"" then
      p_len=len(trim(str))
      
      dim xx
      for xx=1 to p_len
        if asc(mid(str,xx,1))<=1 then
          strlen=int(strlen) + 2
        else
          strlen=int(strlen) + 1
        end if
      next
      end if
  end function
  
  function strLeft(str,lennum)
     strLeft = strMid(str, 1, lennum)
  end function
  
  function strMid(str,startnum, lennum)
      dim p_num, slen
      dim i
      slen = len(str)
      if strlen(str)<=startnum then
        strMid=str
      else
        p_num=0
        
        dim x
        x=0
        do while p_num < startnum and x<slen
          x=x+1
          if asc(mid(str,x,1))<=1 then
            p_num=int(p_num) + 2
          else
            p_num=int(p_num) + 1
          end if
          'response.write("-- x=" & x & " p_num=" & p_num & " startnum=" & startnum & " <br>")
        loop
  
  
        dim y
        y=x
        do while p_num < startnum+lennum and y<slen+1
          y=y+1
          if y<slen then 
            if asc(mid(str,y,1))<=1 then
              p_num=int(p_num) + 2
            else
              p_num=int(p_num) + 1
            end if
        end if
          'response.write("-- y=" & y & " p_num=" & p_num & " startnum+lennum=" & (startnum+lennum) & " slen=" & slen & " <br>")
  
        loop  
  
        strMid =  mid(str,x,y-x)
        if y<=slen then 
          strMid =  strMid & ".."
        end if
      end if
  end function
  
  Rem 过滤SQL非法字符
  function filterSQL(str)
      if isNull(str) or isEmpty(str) then
        filterSQL = ""
      else  
          str=replace(str,"'","''")
          str=replace(str,";"," ")
          str=replace(str,"--"," ")
          filterSQL = str
      end if
  end function  
  
  Rem  过滤脚本
  'function filterScript(text)
  '    if isEmpty(text) or isNull(text) then
  '        exit function
  '    else
  '      Dim re
  '    Set re=new RegExp
  '    re.IgnoreCase =True
  '    re.Global=True
  '      're.Pattern="(&#)"
  '      'text=re.Replace(text,"&amp;#")
  '      re.Pattern="(var )"
  '      text=re.Replace(text,"va&#114 ")
  '      re.Pattern="(function )"
  '      text=re.Replace(text,"functio&#110 ")
  '      re.Pattern="(meta )"
  '      text=re.Replace(text,"met&#97 ")
  '      re.Pattern="(button )"
  '      text=re.Replace(text,"butto&#110 ")
  '      re.Pattern="(window)"
  '      'text=re.Replace(text,"windo&#119")
  '      re.Pattern="(script)"
  '      text=re.Replace(text,"scrip&#116")
  '      're.Pattern="(value)"
  '      'text=re.Replace(text,"valu&#101")
  '      re.Pattern="(js:)"
  '      text=re.Replace(text,"js&#58")
  '      re.Pattern="(vbs:)"
  '      text=re.Replace(text,"vbs&#58" )
  '      re.Pattern="(about:)"
  '      text=re.Replace(text,"about&#58" )
  '      re.Pattern="(file:)"
  '      text=re.Replace(text,"file&#58")
  '      re.Pattern="(document.cookie)"
  '      text=re.Replace(text,"document&#46cookie" )
  '      re.Pattern="((ifr|fr)ame)"
  '      text=re.Replace(text,"$2am&#101" )
  '      re.Pattern="(on(mouse|Exit|error|click|key|load))"
  '      text=re.Replace(text,"&#111n$2")
  '      filterScript=text
  '    end if 
  'end function
  
  function filterScript(strHTML)
      Dim objRegExp, strOutput
      strOutput = strHTML
      Set objRegExp = New Regexp
      objRegExp.IgnoreCase = True
      objRegExp.Global = True
      objRegExp.Pattern = "<" & "script[\s\S]+<" & "/script*>"
      strOutput = objRegExp.Replace(strOutput, "")
      objRegExp.Pattern = " href *= *[\s\S]*script*:"
      strOutput = objRegExp.Replace(strOutput, "")
      objRegExp.Pattern = "<[^<>]+ on[\s\S]+=[^<>]+>"
      strOutput = objRegExp.Replace(strOutput, "<EventDisabled!>")
      objRegExp.Pattern = "<iframe[\s\S]+</iframe*>"
      strOutput = objRegExp.Replace(strOutput,  "")
      objRegExp.Pattern = "<frameset[\s\S]+</frameset*>"
      strOutput = objRegExp.Replace(strOutput,  "")
      Set objRegExp = Nothing
      filterscript = strOutput
   End Function 
  
  
  Rem 过滤非法HTML代码
  function filterHTML(text)
      filterHTML = filterHTML2(text, false)
  end function
  
  Rem 过滤非法HTML代码，
  Rem txt2Html 是否转换空格、换行为HTML代码
  function filterHTML2(text, txt2Html)
    if isEmpty(text) or isNull(text)  then
        exit function
    else
        text = trim(text)
        
        'text = replace(text, ">", "&gt;")
        'text = replace(text, "<", "&lt;")
        text = filterScript(text)
  
        'text = Replace(text, CHR(32), "<I></I>&nbsp;")
        'text = Replace(text, CHR(34), "&quot;")
        text = Replace(text, CHR(36), "&#36;")
        'text = Replace(text, CHR(37), "&#37;")
        'text = Replace(text, CHR(38), "&#38;")
        text = Replace(text, CHR(39), "&#39;")
        
        if txt2Html=true then
            text = Replace(text, "  ", " &nbsp;")
            text = Replace(text, CHR(9), "&nbsp;")
            text = Replace(text, CHR(10), "<BR> ")
            text = Replace(text, CHR(13), "")
        end if
              
        filterHTML2 = text
    end if
  end function
    
  Function HTML2TXT(strHTML)
    if isEmpty(strHTML) or isNull(strHTML)  then
        exit function
    end if
    
    Dim objRegExp
    Set objRegExp = New RegExp
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    objRegExp.Pattern = "<[^<>]+>"
    HTML2TXT = objRegExp.Replace(strHTML, "")  
    Set objRegExp = Nothing
    
  End Function
  
    
  function encodemail(email)
      if isNull(email) then
          encodemail = null
      else
          encodemail = replace(replace(email,"@","&#64;"),".","&#46;")
      end if    
  end function
  
 


  sub message(str)
    call CloseDB()
    response.clear
    if instr(lcase(request.ServerVariables("HTTP_ACCEPT")),"text/vnd.wap.wml")>0 or lcase(response.contentType) = "text/vnd.wap.wml" then
        response.contentType = "text/vnd.wap.wml" 
        response.CharSet=DEFAULT_CHARSET
        response.write "<?xml version='1.0' encoding='" & DEFAULT_CHARSET & "'?>" & vbCrLf &_
            "<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.1//EN"" ""http://www.wapfourm.org/DTD/wml_1.1.xml"">"  & vbCrLf &_
            "<wml>"  & vbCrLf &_
            "  <card title='提示信息' newcontext='false' ordered='true'> "  & vbCrLf &_
            "    <do type='prev' label='返回'><prev /></do>"  & vbCrLf &_
            "    <p>" & request.ServerVariables("HTTP-ACCEPT") & str & "</p>"  & vbCrLf &_
            "  </card> " & vbCrLf &_
            "</wml>"
    else
        response.write "<br><br> " &_
          "  <table width=45% border=1 cellspacing=1 cellpadding=5 bordercolordark=#FFFFFF bordercolorlight=#98ccd0  bordercolor=#98ccd0 align=center >" & vbCrLf &_
          "    <tr>                                                                                 " & vbCrLf &_
          "      <td align=center nowrap height=40px style='FONT-SIZE: x-small;   color:#333333;letter-spacing : 1pt ;line-height :14pt'>-->> .::.::: <b>提示信息</b>  :::.::. <<-- </td>         " & vbCrLf &_
          "    </tr>                                                                                " & vbCrLf &_        
          "    <tr>                                                                                 " & vbCrLf &_
          "     <td align=center style='FONT-SIZE: x-small;   color:#333333;letter-spacing : 1pt ;line-height :14pt'>                                                                   " & vbCrLf &_
          "         <ul>                                                                            " & vbCrLf &_         
          str & vbCrLf &_
          "         </ul>                                                                           " & vbCrLf &_     
          "      </td>                                                                              " & vbCrLf &_         
          "     </tr>                                                                               " & vbCrLf &_              
          "     <tr>                                                                                " & vbCrLf &_          
          "      <td align=center height=40px style='FONT-SIZE: x-small;    color:#333333;letter-spacing : 1pt ;line-height :14pt'> "   & vbCrLf &_          
          "         <input style='border:1px dotted #98ccd0;background-color:#ffffff;font-family:verdana;font-size:x-small;height:18px;width:60px' type=button onclick='history.back()' value='后退'> "   & vbCrLf &_
          "         <input style='border:1px dotted #98ccd0;background-color:#ffffff;font-family:verdana;font-size:x-small;height:18px;width:60px' type=button onclick='document.location=""index.asp?blog_id=" & request("blog_id") & "&cat_id=" & request("cat_id") & "&pageno=" &request("pageno")& """' value='返回'> "   & vbCrLf &_
          "      </td>  " & vbCrLf &_  
          "     </tr>                                                                               " & vbCrLf &_      
          "  </table>                                                                               " & vbCrLf       
    end if    
'      response.redirect("message.asp?blog_id=" & blogObj.blogId & "&msg=" & str)
    response.end
  end sub 



  '分页公共程序
  function getPageLink(totalPage, curPageNo, pageSize, recordCount, url, pageName)
    getPageLink = htmlPageLink2(curPageNo, pageSize, recordCount, url, pageName)
  end function
  
  function htmlPageLink(curPageNo, pageSize, totalSize, url)
    htmlPageLink = htmlPageLink2(curPageNo, pageSize, totalSize, url, "pageno")
  end function 

  function htmlPageLink2(curPageNo, pageSize, totalSize, pageUrl, pageName)
    dim htmlCode, totalPage, url
    
    url = pageUrl

    if isEmpty(curPageNo) or clng(curPageNo)<1 then
        curPageNo =1 
    end if
    curPageNo =  clng(curPageNo)
    
    if isNull(pageSize) or isEmpty(pageSize) or clng(pageSize)<1 then
        pageSize = 10
    end if

    if isNull(totalSize) or isEmpty(totalSize) or clng(totalSize)<1 then
        totalSize =1 
    end if
    totalSize = clng(totalSize)
        

    totalPage = (totalSize + pageSize -1) \ pageSize

    if InStrRev(url,"?")<1 then
      url = url & "?"
    else
        url  = url & "&"
    end if
    
  htmlCode = "<a name='#_" & pageName & "'></a><center>"
  
    if totalPage>1 then
  
      if (curPageNo<totalPage) then
        htmlCode = htmlCode & "<a class=pagelink href='" & url & pageName & "=" & (curPageNo+1) & "#" & pageName & "'>下一页</a>,"
      end if

      if (curPageNo>1) then
        htmlCode = htmlCode & "<a class=pagelink href='" & url & pageName & "=" & (curPageNo-1) &  "#" & pageName &"'>上一页</a>,"
      end if
            
      dim i, sPageNo, ePageNo
      sPageNo = curPageNo - 3
      
      if totalPage - curPageNo<5 then 
        sPageNo = totalPage-7
    end if
    
      if sPageNo<2 then
          sPageNo=2
      end if

      ePageNo = curPageNo + 4
      if curPageNo<4 then 
        ePageNo = 8
    end if
          
      if ePageNo>totalPage-1 then
          ePageNo = totalPage-1
      end if
      htmlCode = htmlCode & "第"
      if curPageNo=1 then 
        htmlCode = htmlCode & "1,"
      else
        htmlCode = htmlCode & "<a class=pagelink href='" & url & pageName & "=" & 1 & "#" & pageName & "'>" & 1 & "</a>,"
      end if
      
      for i=sPageNo to ePageNo
        
        if i=curPageNo then
          htmlCode = htmlCode & i & ","
        elseif i=sPageNo and sPageNo<>2 then
          htmlCode = htmlCode & "<a class=pagelink href='" & url & pageName & "=" & i &  "#" & pageName &"'>..</a>,"
        elseif i=ePageNo and ePageNo<>totalPage-1 then
          htmlCode = htmlCode & "<a class=pagelink href='" & url & pageName & "=" & i &  "#" & pageName &"'>..</a>,"
        else
          htmlCode = htmlCode & "<a class=pagelink href='" & url & pageName & "=" & i &  "#" & pageName &"'>" & i &  "</a>,"
        end if
        
      next  
      
      if curPageNo=totalPage then 
        htmlCode = htmlCode & totalPage
      else
        htmlCode = htmlCode & "<a class=pagelink href='" & url & pageName & "=" & totalPage &  "#" & pageName &"'>" & totalPage & "</a>"
      end if
      htmlCode = htmlCode & "页"
      htmlCode = htmlCode & "</center>"
      

  end if
      
    
    ' htmlCode = ""  &_
    '   "    <" & "script language=javascript>                     " & vbCrLf &_
    '   "      function change" & pageName & "(pageNo){       " & vbCrLf &_
    '   "          document.getElementById('" & pageName & "').value=pageNo;       " & vbCrLf &_
    '   "          document.location.href='" & url & pageName & "='+pageNo+'';  " & vbCrLf &_
    '   "      }                                              " & vbCrLf &_
    '   "    <" & "/script>                                        " & vbCrLf &_
    '   "    <div align=center style='FONT-SIZE: 9pt;text-align:center' >                   " & vbCrLf 
    ' htmlCode = htmlCode & "  共" & totalPage & "页  " & vbCrLf 
    ' if (curPageNo>1) then
    '   htmlCode = htmlCode &_ 
    '       "       <a href='" & url & pageName & "=1'><font face=webdings >9</font></a>                        " & vbCrLf &_
    '       "       <a href='" & url & pageName & "=" & (curPageNo-1) & "'><font face=webdings >7</font></a>    " & vbCrLf 
    ' else  
    '   htmlCode = htmlCode &_ 
    '       "       <font face=webdings >9</font>         " & vbCrLf &_
    '       "       <font face=webdings >7</font>         " & vbCrLf 
    ' end if
    ' htmlCode = htmlCode &_ 
    '   "           第                                          " & vbCrLf &_  
    '   "           <select name=" & pageName &"  id=" & pageName &" onchange=change" & pageName & "(this.value) >   " & vbCrLf 
    ' 
    ' dim i, sPageNo, ePageNo
    ' sPageNo = curPageNo-20
    ' if sPageNo<1 then
    '     sPageNo=1
    ' end if
    ' ePageNo = curPageNo + 20 
    ' if ePageNo>totalPage then
    '     ePageNo = totalPage
    ' end if
    ' 'for i=1 to totalPage
    ' for i=sPageNo to ePageNo
    '   htmlCode = htmlCode & " <option value=" & i 
    '   if i=curPageNo then
    '     htmlCode = htmlCode & " selected "
    '   end if
    '   htmlCode = htmlCode &  ">" 
    '   if (i = sPageNo and sPageNo<>1) or (i = ePageNo and ePageNo<>totalPage) then
    '     htmlCode = htmlCode &  "..." 
    '   else
    '     htmlCode = htmlCode &  i
    '   end if  
    '   htmlCode = htmlCode  & "</option> " & vbCrLf  
    ' next  
    ' 
    ' htmlCode = htmlCode &_
    '   "           </select>                      " & vbCrLf &_
    '   "           页                             " & vbCrLf 
    ' if (curPageNo<totalPage) then
    '   htmlCode = htmlCode &_ 
    '       "       <a href='" & url  & pageName & "=" & (curPageNo+1) & "'><font face=webdings >8</font></a>                        " & vbCrLf &_
    '       "       <a href='" & url  & pageName & "=" & (totalPage) & "'><font face=webdings >:</font></a>    " & vbCrLf 
    ' else  
    '   htmlCode = htmlCode &_ 
    '       "       <font face=webdings >8</font></a>         " & vbCrLf &_
    '       "       <font face=webdings >:</font></a>         " & vbCrLf 
    ' end if
    ' 
    ' htmlCode = htmlCode &_ 
    '   "     </div>                             " & vbCrLf  
    ' 
    htmlPageLink2 = htmlCode
  end function
  
  
  
  
sub saveReferer 
    on error resume next
    dim referer, server_name, full_url, query_string,remote_host
    server_name = Request.ServerVariables("SERVER_NAME") 
    referer = Request.ServerVariables("HTTP_REFERER")

    
    if (Not isEmpty(referer) And mid(referer,8,len(server_name))<>server_name  And REFER_LOG_LEVEL >= 1) then
        call openDB
        full_url = Request.ServerVariables("URL") 
        query_string =  Request.ServerVariables("QUERY_STRING") 
        remote_host =   Request.ServerVariables("REMOTE_HOST") 
        if query_string<>"" then
            full_url = full_url & "?" & query_string
        end if
        dim content_id
        content_id = request("content_id")
        if content_id="" then
            content_id= "null"
        else
            content_id=clng(content_id)
        end if

        
        sql = "select blog_id, content_id, url, referer,remote_host from blog_referer where 1=0"
        rs.open sql, conn, 1, 3
        rs.addNew()
        rs("blog_id") = blogObj.blogId
        rs("content_id") = content_id
        rs("url") = full_url
        rs("referer") = referer 
        
        rs("remote_host") = remote_host
        rs.update()
        rs.close()
    end if
    on error goto 0
end sub  


  sub assertConnected
    if not response.isClientConnected then
        call closeDB()
        response.clear
        response.end
    end if
  end sub
  
  sub createSkinCacheFolders(skinName)

        dim relativePath, realPath, FSO
    
        Set FSO=Server.CreateObject("Scripting.FileSystemObject")
        
        relativePath = MISSLOG_ROOT & "/skin_cache"
        realPath = Server.MapPath(relativePath)
        if not FSO.FolderExists(realPath) then
            FSO.CreateFolder(realPath)
        end if
        
        relativePath =  MISSLOG_ROOT & "/skin_cache/" & skinName
        realPath = Server.MapPath(relativePath)
        
        if not FSO.FolderExists(realPath) then
            FSO.CreateFolder(realPath)
        end if
        
        Set FSO = nothing
            
  end sub
  
  sub createDataFolders
  
        dim relativePath, realPath, FSO
    
        Set FSO=Server.CreateObject("Scripting.FileSystemObject")
        
        relativePath = MISSLOG_ROOT & "/data"
        realPath = Server.MapPath(relativePath)
        if not FSO.FolderExists(realPath) then
            FSO.CreateFolder(realPath)
        end if
    
        if blogObj.blogId="" then
            relativePath =  MISSLOG_ROOT & "/data/default"
        else
            relativePath =  MISSLOG_ROOT & "/data/" & blogObj.blogId
        end if
        realPath = Server.MapPath(relativePath)
        
        if not FSO.FolderExists(realPath) then
            FSO.CreateFolder(realPath)
        end if
        
        Set FSO = nothing
          
  
  end sub  
  
  sub writeTextFile(relativePath, byRef text, encode)
    dim out
    set out = Server.CreateObject("ADODB.Stream")
    out.type = 2 'adTypeText
    out.charSet = encode
    out.lineSeparator = -1  'adCRLF
    out.open
    out.writeText(text)
    out.saveToFile Server.MapPath(relativePath), 2 'adSaveCreateOverWrite
    out.close
    set out = nothing
  end sub
</script>